home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / utils2 / paws2.arj / PAWS2.BAS < prev    next >
BASIC Source File  |  1994-01-01  |  6KB  |  216 lines
  1. '********************************PAWS2.BAS*******************************
  2. '
  3. '                                Version 1.2
  4. '1/1/94
  5. '
  6. 'This program will run in the QuickBASIC environment and you can make
  7. 'stand-alone *.EXE files that permit you to use a mouse in a DOS program.
  8. 'When you start QuickBASIC, you MUST load the Quick Library QB.QLB
  9. 'so that you can CALL INTERRUPT.
  10. '
  11. 'The command is:
  12. 'QB/L QB.QLB
  13. '
  14. 'I have called this PAWS2.BAS (and the executable program PAWS2.COM)
  15. 'because it has two (2) PAUSE commands, keyboard and mouse.
  16. '
  17. 'Please... please... no applause for the PAWS2 play on words as I
  18. 'am sure you know that a mouse has paws too (2?).
  19. '
  20. '
  21. 'And... if you want to disable your -Microsoft mouse-, just use the command:
  22. '
  23. 'SHELL "mouse off"
  24. 'in the immediate window to disable the driver and run the program again.
  25. '
  26. 'go to the SUB IsMouse(Yes%) and uncomment the error message lines to see
  27. 'what displays.
  28. '
  29. 'run the program some more.
  30. '
  31. 'SHELL "mouse on"
  32. 'to reset the software.
  33. '
  34. 'This program evolved from Microsoft programs on the MSBASIC Forum of
  35. 'CompuServe. They really didn't explain -everything- so, I bought
  36. '"Microsoft Mouse Programming Reference 2nd Edition," Microsoft Press 1991
  37. 'which cleared up a lot of questions and raised even more.
  38. '
  39. 'This is a giant step forward, not for mankind, but for mouse users that
  40. 'want that mouse for QuickBASIC 4.5 use.
  41. '
  42. 'John De Palma on CompuServe 76076,571
  43. '
  44. '1/1/94
  45. '
  46. DEFINT A-Z
  47. CONST False = 0
  48. CONST True = NOT False
  49.  
  50. 'interrupt call for both INTERRUPT and INTERRUPTX
  51. TYPE RegType
  52.      ax    AS INTEGER
  53.      bx    AS INTEGER
  54.      cx    AS INTEGER
  55.      dx    AS INTEGER
  56.      bp    AS INTEGER
  57.      si    AS INTEGER
  58.      di    AS INTEGER
  59.      flags AS INTEGER
  60.      ds    AS INTEGER
  61.      es    AS INTEGER
  62. END TYPE
  63.  
  64. 'SUB name describes purpose and function
  65. DECLARE SUB MouseBorder (UpperRow%, LeftCol%, LowerRow%, RightCol%)
  66. DECLARE SUB MouseFunction (m1%, m2%, m3%, m4%)
  67. DECLARE SUB ButtonStatus (m1%, m2%, m3%, m4%)
  68. DECLARE SUB IsMouse (Yes%)
  69. DECLARE SUB SetCursor (row%, col%)
  70. DECLARE SUB ClearBuffer ()
  71. DECLARE SUB ShowCursor (Hide%)
  72. DECLARE SUB HideCursor (Hide%)
  73. DECLARE SUB resetmouse ()
  74.  
  75. 'executable code below
  76.  
  77. 'COLOR 15, 1                    'don't want these except for testing
  78. 'CLS
  79.  
  80. 'a single line global function to center text
  81. DEF FnCenter (text$) = 41 - (LEN(text$) \ 2)
  82.  
  83. 'the next command places Copyright information into the *.COM file...
  84. 'just in case someone uses PAWS2.COM for commerical use as his own.
  85. 'it NEVER displays when the program runs.
  86. Copyright$ = "∙Copyright∙(c)∙Sat,∙Jan∙1,∙1994∙John∙De∙Palma∙LearnWare∙"
  87.  
  88. 'SCREEN 0                       'these two commands clear the screen
  89. 'WIDTH 80                       'don't want that
  90.  
  91. CALL IsMouse(Yes%)
  92.   
  93.     IF Yes% THEN
  94.         PRINT "CLICK! or Press a key to Continue...";
  95.             row = CSRLIN
  96.             col = POS(0)
  97.         CALL SetCursor(row, col)
  98.             row2 = row
  99.             col2 = col + 2
  100.         CALL MouseBorder(row, col, row2, col2)  'fixes cursor position
  101.         ClearBuffer
  102.         DO
  103.             CALL ButtonStatus(m1, m2, m3, m4)
  104.         LOOP UNTIL LEN(INKEY$) OR m2 <> 0
  105.         'CALL HideCursor(Hide%)                 'use this if doing more stuff
  106.         CALL resetmouse                         'use this to end
  107.     ELSE
  108.         PRINT "Press a Key to Continue...";
  109.         ClearBuffer
  110.         WHILE INKEY$ = "": WEND
  111.     END IF
  112.  
  113. SUB ButtonStatus (m1, m2, m3, m4)
  114.     m1 = 3
  115.     CALL MouseFunction(m1, m2, m3, m4)
  116.  
  117. END SUB
  118.  
  119. SUB ClearBuffer
  120. WHILE INKEY$ <> "": WEND
  121. END SUB
  122.  
  123. SUB HideCursor (Hide%)
  124.     m1 = 2
  125.     CALL MouseFunction(m1, 0, 0, 0)
  126.     Hide% = Hide% + 1             'have to show cursor one more than
  127. END SUB                           'this number to see the cursor again
  128.  
  129. 'tests for Mouse Software installed then Mouse Hardware.
  130. 'uncomment the lines to see error messages and mouse information.
  131. SUB IsMouse (Yes%)
  132.     Yes% = True
  133.     DEF SEG = 0
  134.   
  135.     MouseSegment& = 256& * PEEK(207) + PEEK(206)
  136.     MouseOffset& = 256& * PEEK(205) + PEEK(204)
  137.  
  138.     DEF SEG = MouseSegment&
  139.  
  140.     IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
  141.         Yes% = False
  142.         MouseChecked = True
  143.         DEF SEG
  144.         'text$ = "Can't Find Mouse-Driver -> SOFTWARE!"
  145.         'LOCATE , FnCenter(text$)
  146.         'PRINT text$
  147.         EXIT SUB
  148.     END IF
  149.   
  150.     m1 = 0                          'mouse reset and status
  151.     CALL MouseFunction(m1, m2, 0, 0)
  152.     IF m1 THEN
  153.         'text$ = "A -" + LTRIM$(STR$(m2)) + "- BUTTON mouse is present"
  154.         'LOCATE , FnCenter(text$)
  155.         'PRINT text$
  156.         CALL ShowCursor(Hide%)      'show cursor
  157.     ELSE
  158.         'text$ = "Can't find Mouse-Driver - HARDWARE or Software!"
  159.         'LOCATE , FnCenter(text$)
  160.         'PRINT text$
  161.         Yes% = False
  162.     END IF
  163. END SUB
  164.  
  165. SUB MouseBorder (UpperRow, LeftCol, LowerRow, RightCol) STATIC
  166.           
  167.     UpperRow = (UpperRow - 1) * 8       'For SCREEN 0
  168.     LeftCol = (LeftCol - 1) * 8         'left upper corner is 0,0
  169.     LowerRow = (LowerRow - 1) * 8       'converting to pixels
  170.     RightCol = (RightCol - 1) * 8
  171.     
  172.     CALL MouseFunction(7, 0, LeftCol, RightCol)
  173.     CALL MouseFunction(8, 0, UpperRow, LowerRow)
  174.  
  175. END SUB
  176.  
  177. SUB MouseFunction (m1%, m2%, m3%, m4%)
  178.   
  179.     DIM Regs AS RegType
  180.  
  181.     Regs.ax = m1
  182.     Regs.bx = m2
  183.     Regs.cx = m3
  184.     Regs.dx = m4
  185.  
  186.     CALL INTERRUPT(&H33, Regs, Regs)
  187.  
  188.     m1 = Regs.ax
  189.     m2 = Regs.bx
  190.     m3 = Regs.cx
  191.     m4 = Regs.dx
  192.  
  193. END SUB
  194.  
  195. SUB resetmouse
  196. CALL MouseFunction(0, 0, 0, 0)
  197. END SUB
  198.  
  199. SUB SetCursor (row%, col%) STATIC
  200.     m1 = 4
  201.     m3 = (col% - 1) * 8
  202.     m4 = (row% - 1) * 8
  203.     CALL MouseFunction(m1, 0, m3, m4)
  204.  
  205. END SUB
  206.  
  207. SUB ShowCursor (Hide%)
  208.   
  209.     FOR i = Hide% TO Hide% + 1           'have to show once more than hide
  210.         m1 = 1                           'ie, hide cursor twice, show thrice
  211.         CALL MouseFunction(m1, 0, 0, 0)
  212.     NEXT
  213.  
  214. END SUB
  215.  
  216.